home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 011-020 / amok19 / area / graphdemo.mod < prev    next >
Text File  |  1993-11-04  |  8KB  |  322 lines
  1. (*---------------------------------------------------------------------------
  2.     :Program.     GraphDemo.mod
  3.     :Contents.      Demonstriert BackDrop, Area und Pattern auf EHB-Screen
  4.     :Author.      Bernd Preusing
  5.     :Address.      Gerhardstr. 16  D-2200 Elmshorn
  6.     :Phone.      04121/22486
  7.     :Copyright.      Public Domain
  8.     :Language.      Modula-2
  9.     :Translator.  M2Amiga V3.2e
  10.     :History.      0.0 13-May-89 Preusing
  11.     :Imports.      BackDrop 1.2 Preusing
  12.     :Imports.      LoPattern 1.0 Preusing
  13.     :Imports.      Area 1.0 Preusing
  14.     :Imports.      BeamRandom 1.0 Preusing
  15.     :Bugs.      nur in der graphics.library
  16.     :Remark.      Ein saumäßiges Programm, bitte nicht ansehen!
  17.     :Remark.      Rectangle und Bar sind allgemein brauchbar!
  18.     :Usage.      Starten und öfter mal die linke Maustaste drücken.
  19. ---------------------------------------------------------------------------*)
  20. MODULE GraphDemo;
  21.  
  22. FROM SYSTEM    IMPORT    BITSET, CAST, ADR, ADDRESS, INLINE, SHIFT;
  23. FROM Arts    IMPORT    Assert, CurrentLevel, TermProcedure, BreakPoint;
  24. FROM Heap    IMPORT    Allocate, AllocMem;
  25. FROM BackDrop    IMPORT    OpenBackDrop, BdRp;
  26. FROM Graphics    IMPORT    RastPortPtr, SetAPen, SetBPen, Move, Draw, PolyDraw,
  27.             RectFill, DrawEllipse,
  28.             Flood, SetDrMd, DrawModes, DrawModeSet,jam2;
  29. FROM Exec    IMPORT    CopyMem;
  30. FROM Area    IMPORT    InitArea, AreaMove, AreaDraw, AreaEllipse, AreaCircle,
  31.             AreaEnd;
  32. FROM GfxMacros    IMPORT    SetOPen, SetDrPt, BndryOff;
  33. FROM BeamRandom    IMPORT    RND;
  34. FROM LoPattern    IMPORT    Pattern, SetPattern;
  35.  
  36.  
  37. CONST DEPTH = 6; (* gibt Extrahalfbrite *)
  38.       MAXCOLS = CAST(INTEGER,SHIFT(1,DEPTH));
  39.       WIDTH = 340; (* Overscan! *)
  40.       HEIGHT = 256;
  41.  
  42. VAR rp: RastPortPtr;
  43.     MaxPatt: INTEGER;
  44.  
  45.  
  46. PROCEDURE WaitButton;
  47. VAR ciaa[0BFE001H]:SET OF [0..7];
  48. BEGIN
  49.   REPEAT
  50.   UNTIL NOT(6 IN ciaa);
  51.   REPEAT
  52.   UNTIL (6 IN ciaa)
  53. END WaitButton;
  54.  
  55. PROCEDURE ButtonPressed():BOOLEAN;
  56. VAR ciaa[0BFE001H]:SET OF [0..7];
  57. BEGIN
  58.   RETURN NOT(6 IN ciaa)
  59. END ButtonPressed;
  60.  
  61.  
  62. PROCEDURE Bar(col,xl,yu,w,h:INTEGER);
  63. VAR xr,yo:INTEGER;
  64. BEGIN
  65.   xr:=xl+w-1;
  66.   yo:=yu-h+1;
  67.   SetAPen(rp,col);
  68.   SetOPen(rp,1);
  69.   SetBPen(rp,2);
  70.   SetDrMd(rp,jam2);
  71.   SetPattern(rp,Pattern(0));
  72.   RectFill(rp,xl,yo,xr,yu);
  73.   SetPattern(rp,half);
  74.   AreaMove(rp,xl,yo);
  75.   AreaDraw(rp,xl+5,yo-5);
  76.   AreaDraw(rp,xr+5,yo-5);
  77.   AreaDraw(rp,xr,yo);
  78.   AreaMove(rp,xr,yo);
  79.   AreaDraw(rp,xr+5,yo-5);
  80.   AreaDraw(rp,xr+5,yu-5);
  81.   AreaDraw(rp,xr,yu);
  82.   AreaEnd(rp);
  83. END Bar;
  84.  
  85. PROCEDURE AreaTest;
  86.  
  87.   PROCEDURE Min(a,b:INTEGER):INTEGER;
  88.   BEGIN
  89.     IF a<b THEN RETURN a ELSE RETURN b END
  90.   END Min;
  91.  
  92. VAR rp: RastPortPtr; i: INTEGER;
  93.     a1,b1,a2,b2: INTEGER;
  94. BEGIN
  95.   rp:=BdRp;
  96.   SetDrMd(rp,DrawModeSet{dm0});
  97.  
  98.   SetAPen(rp,1);
  99.   SetBPen(rp,6);
  100.   SetOPen(rp,5);
  101.  
  102.   AreaEllipse(rp,80,100,60,70);
  103.   AreaEnd(rp);
  104. WaitButton;
  105.   SetAPen(rp,3);
  106.   AreaMove(rp,10,10);
  107.   AreaDraw(rp,WIDTH-20,80);
  108.   AreaDraw(rp,300,100);
  109.   AreaDraw(rp,80,200);
  110.   AreaDraw(rp,10,10);
  111.   AreaEnd(rp);
  112. WaitButton;
  113.  
  114.   SetAPen(rp,9);
  115.   AreaMove(rp,10,50);
  116.   AreaDraw(rp,WIDTH-10,50);
  117.   AreaDraw(rp,WIDTH/2,200);
  118.   AreaMove(rp,WIDTH/2,10);
  119.   AreaDraw(rp,WIDTH-10,160);
  120.   AreaDraw(rp,10,160);
  121.   AreaEnd(rp);
  122. WaitButton;
  123.  
  124.   SetAPen(rp,7);
  125.   AreaMove(rp,WIDTH-1,200);
  126.   AreaDraw(rp,WIDTH-20,180);
  127.   AreaDraw(rp,WIDTH-20,200);
  128.   AreaDraw(rp,WIDTH-1,200);
  129.   AreaEnd(rp);
  130. WaitButton;
  131.  
  132.   SetAPen(rp,2);
  133.   AreaEllipse(rp,90,100,60,70);
  134.   AreaEnd(rp);
  135. WaitButton;
  136.  
  137.   SetAPen(rp,4);
  138.   AreaEllipse(rp,WIDTH/2,100,100,80);
  139.   AreaEnd(rp);
  140. WaitButton;
  141.   
  142.   SetAPen(rp,5); (* = OPen *)
  143.   DrawEllipse(rp,WIDTH/2+10,100,100,80);
  144.   WaitButton;
  145.   SetAPen(rp,1);
  146.   IF Flood(rp,0,WIDTH/2+10,100)=0 THEN END;
  147.  
  148.   FOR i:=MIN(INTEGER) TO MAX(INTEGER) DO END;
  149.   BndryOff(rp);
  150.  
  151. WaitButton;
  152. BndryOff(rp);
  153.   LOOP
  154.     SetAPen(rp,RND(MAXCOLS));
  155.     SetBPen(rp,RND(MAXCOLS));
  156.     SetOPen(rp,RND(MAXCOLS));
  157.     SetPattern(rp,Pattern(RND(MaxPatt+1)));
  158.     IF RND(2)=1 THEN
  159.       AreaMove(rp,RND(WIDTH-10)+2,RND(HEIGHT-10)+2);
  160.       FOR i:=1 TO 10 DO
  161.         AreaDraw(rp,RND(WIDTH-10)+2,RND(HEIGHT-10)+2);
  162.       END;
  163.       AreaEnd(rp)
  164.     ELSE
  165.       a1:=RND(WIDTH-20)+10; b1:=RND(HEIGHT-20)+10;
  166.       a2:=a1+RND(WIDTH-20-a1)+2; b2:=b1+RND(HEIGHT-20-b1)+2;
  167.       AreaMove(rp,a1,b1);
  168.       AreaDraw(rp,a1,b2);
  169.       AreaDraw(rp,a2,b2);
  170.       AreaDraw(rp,a1,b1);
  171.       (* RectFill(rp,a1,b1,a2,b2); *)
  172.       AreaEllipse(rp,a1,b1,RND(Min(a1,WIDTH-a1-4)+2),RND(Min(b1,HEIGHT-b1-4))+2);
  173.       AreaEnd(rp);
  174.     END;
  175.     IF ButtonPressed() THEN EXIT END;
  176.   END;
  177. END AreaTest;
  178.  
  179. PROCEDURE PattTest(rp: RastPortPtr);
  180. VAR x,y,i,xw,yh:INTEGER;
  181. CONST Zeilen = 3;
  182. BEGIN
  183.   SetDrPt(rp,0FFFFH);
  184.   SetAPen(rp,1); SetOPen(rp,2);
  185.   xw:=WIDTH/(MaxPatt/Zeilen+1);
  186.   yh:=HEIGHT/Zeilen;
  187.   x:=0; y:=0;
  188.   FOR i:=0 TO MaxPatt DO
  189.     SetPattern(rp,Pattern(i));
  190.     RectFill(rp,x,y,x+xw-1,y+yh-1);
  191.     INC(x,xw); 
  192.     IF x>WIDTH-10 THEN x:=0; INC(y,yh) END;
  193.   END;
  194.   WaitButton;
  195. END PattTest;
  196.  
  197. PROCEDURE EHBTest(rp: RastPortPtr);
  198. VAR x,y,i,xw,yh:INTEGER;
  199. CONST Zeilen = 4;
  200. BEGIN
  201.   SetDrPt(rp,0FFFFH);
  202.   SetAPen(rp,1); BndryOff(rp);
  203.   xw:=WIDTH/16;
  204.   yh:=HEIGHT/Zeilen;
  205.   x:=0; y:=0;
  206.   SetPattern(rp,Pattern(0));
  207.   FOR i:=0 TO 63 DO
  208.     SetAPen(rp,i);
  209.     RectFill(rp,x,y,x+xw-1,y+yh-1);
  210.     INC(x,xw); 
  211.     IF x>WIDTH-10 THEN x:=0; INC(y,yh) END;
  212.   END;
  213.   WaitButton;
  214. END EHBTest;
  215.  
  216. PROCEDURE Rectangle(rp: RastPortPtr; x1,y1,x2,y2:INTEGER);
  217. TYPE iPtr = POINTER TO INTEGER;
  218. VAR i: iPtr;
  219.     re: ARRAY[1..4] OF RECORD x,y:INTEGER END;
  220. BEGIN
  221.   Move(rp,x1,y1);
  222.   i:=ADR(re);
  223.   i^:=x2; INC(i,2);  i^:=y1; INC(i,2);
  224.   i^:=x2; INC(i,2);  i^:=y2; INC(i,2);
  225.   i^:=x1; INC(i,2);  i^:=y2; INC(i,2);
  226.   i^:=x1; INC(i,2);  i^:=y1;
  227.   PolyDraw(rp,4,ADR(re));
  228. END Rectangle;
  229.  
  230. PROCEDURE HighResRect(rp: RastPortPtr; x1,y1,x2,y2:INTEGER);
  231. TYPE iPtr = POINTER TO INTEGER;
  232. VAR i: iPtr;
  233.     re: ARRAY[1..7] OF RECORD x,y:INTEGER END;
  234. BEGIN
  235.   Move(rp,x1,y1); (* rechts und links doppelt *)
  236.   i:=ADR(re);
  237.   i^:=x1; INC(i,2);  i^:=y2; INC(i,2);
  238.   i^:=x2; INC(i,2);  i^:=y2; INC(i,2);
  239.   i^:=x2; INC(i,2);  i^:=y1; INC(i,2);
  240.   i^:=x1+1; INC(i,2);  i^:=y1; INC(i,2);
  241.   i^:=x1+1; INC(i,2);  i^:=y2; INC(i,2);
  242.   i^:=x2-1; INC(i,2);  i^:=y2; INC(i,2);
  243.   i^:=x2-1; INC(i,2);  i^:=y1;
  244.   PolyDraw(rp,7,ADR(re));
  245. END HighResRect;
  246.  
  247.  
  248. PROCEDURE f(rp{1+8}:RastPortPtr;farbe{2}:INTEGER);
  249. VAR i: INTEGER;
  250. BEGIN
  251.   FOR i:=10 TO WIDTH-10 BY 2 DO
  252.     farbe:=CAST(INTEGER,CAST(BITSET,farbe)/BITSET{1});
  253.     SetAPen(rp,farbe);
  254.     Move(rp,WIDTH/2,10); Draw(rp,i,100);
  255.     Draw(rp,WIDTH/2,180);
  256.   END;
  257.   SetAPen(rp,3);
  258.   Move(rp,10,100); Draw(rp,WIDTH-20,100);
  259. END f;
  260.  
  261. PROCEDURE CircleTest(rp:RastPortPtr);
  262. VAR i,j,k,l:INTEGER;
  263. BEGIN
  264.   FOR i:=1 TO 20 DO
  265.     j:=RND(WIDTH-20)+10; k:=RND(HEIGHT-10)+5;
  266.     l:=RND(WIDTH-300)+10;
  267.     SetAPen(rp,RND(MAXCOLS+1));
  268.     DrawEllipse(rp,j,k,l,l);
  269.   END;
  270.   WaitButton;
  271. END CircleTest;
  272.  
  273. PROCEDURE BarTest();
  274. VAR i,br,h:INTEGER;
  275. BEGIN
  276.   Bar(3,10,HEIGHT-10,200,HEIGHT-20);
  277.   Bar(0,210,150,50,100);
  278.   WaitButton;
  279.   br:=(WIDTH-10)/12;
  280.   FOR i:=0 TO 11 DO
  281.     h:=RND(HEIGHT-20)+10;
  282.     Bar(i+3,i*br+5,HEIGHT-5,br+1,h);
  283.   END;
  284.   WaitButton;
  285.   FOR i:=0 TO 11 DO
  286.     h:=RND(HEIGHT-80)+10;
  287.     Bar(i+3,200-i*5,(HEIGHT-5-55)+i*5,30,h);
  288.   END;
  289. END BarTest;
  290.  
  291. VAR i: INTEGER;
  292.  
  293. BEGIN
  294.   MaxPatt:=INTEGER(MAX(Pattern));
  295.   OpenBackDrop(DEPTH,WIDTH,HEIGHT,ADR('Press left Mouse Button'));
  296.   rp:=BdRp;
  297.   SetDrPt(rp,0F0F0H);
  298.   InitArea(rp,50,AllocMem);
  299.   f(rp,1);
  300.   WaitButton;
  301.   FOR i:=0 TO 200 BY 2 DO
  302.     Rectangle(rp,i,i,WIDTH-10,HEIGHT-20);
  303.   END;
  304.   EHBTest(rp);
  305.   CircleTest(rp);
  306.   PattTest(rp);
  307.   AreaMove(rp,150,100);
  308.   AreaDraw(rp,250,160);
  309.   AreaDraw(rp,150,160);
  310.   AreaDraw(rp,250,100);
  311.   AreaCircle(rp,150,100,40);
  312.   AreaCircle(rp,150,100,80);
  313.   AreaEnd(rp);
  314.   WaitButton;
  315.  
  316.   WaitButton;
  317.   BarTest;
  318.   WaitButton;
  319.   AreaTest;
  320.   WaitButton;
  321. END GraphDemo.
  322.